home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / C / Applications / Moscow ML 1.31 / source code / mosml / src / mosmllib / Time.sml < prev    next >
Encoding:
Text File  |  1996-07-03  |  4.8 KB  |  143 lines  |  [TEXT/R*ch]
  1. (* Time -- new basis 1995-02-25, 1995-05-12 *)
  2.  
  3. local 
  4.     prim_val getrealtime_ : unit -> {sec : int, usec : int} = 
  5.                                                       1 "sml_getrealtime";
  6.     fun negpow10 p = exp(ln 10.0 * real (~p));
  7.  
  8.     (* Translation to obtain a longer time horizon.  Must agree with
  9.        TIMEBASE in file runtime/mosml.c *)
  10.     val timebase = ~1073741824;        
  11. in
  12.     type time = {sec : int, usec : int}
  13.     (* Invariant: sec >= timebase and 0 <= usec < 1000000.
  14.        Represents the duration (sec-timebase)+usec/1000000 seconds; 
  15.        or the duration since UTC 00:00 on 1 Jan 1970).
  16.      *)
  17.  
  18.     exception Time
  19.  
  20.     val zeroTime = {sec = timebase, usec = 0};
  21.     fun now () = getrealtime_ ();
  22.  
  23.     fun fromSeconds s = 
  24.     if s < 0 then raise Time else {sec=s+timebase, usec=0};
  25.  
  26.     fun fromMilliseconds ms = 
  27.     if ms < 0 then raise Time else 
  28.         {sec=ms quot 1000+timebase, usec=ms rem 1000 * 1000};
  29.  
  30.     fun fromMicroseconds us = 
  31.     if us < 0 then raise Time else 
  32.         {sec=us quot 1000000+timebase, usec=us rem 1000000};
  33.  
  34.     fun toSeconds {sec, usec} = sec-timebase;
  35.  
  36.     fun toMilliseconds {sec, usec} = (sec-timebase) * 1000 + usec quot 1000;
  37.  
  38.     fun toMicroseconds {sec, usec} = (sec-timebase) * 1000000 + usec;
  39.  
  40.     fun realToTime r =               
  41.     let 
  42.         val rf = if r < 0.0 then raise Time else floor (r + real timebase)
  43.     in
  44.         {sec = rf, usec = floor (1000000.0 * (r+real timebase-real rf))} 
  45.     end handle Overflow => raise Time;
  46.  
  47.     fun timeToReal {sec, usec} =
  48.     real sec - real timebase + real usec / 1000000.0;
  49.  
  50.     fun timeToUnits (t, p) = floor(timeToReal t * negpow10 p + 0.5);
  51.  
  52.     fun fmt p {sec, usec} =
  53.     let fun frac r = r - real (floor r) 
  54.         val rnd  = if p < 0 then 0.5 
  55.                else 0.5 * negpow10 p 
  56.         val usecr = real usec / 1000000.0 + rnd
  57.         val ints = General.makestring (sec - timebase + floor usecr)
  58.         fun h v i = if i <= 0 then []
  59.             else Char.chr (floor v + Char.ord #"0") 
  60.                              :: h (10.0 * frac v) (i-1)
  61.     in 
  62.         if p > 0 then 
  63.         ints ^ "." ^ String.implode (h (10.0 * frac usecr) 
  64.                          (if p > 6 then 6 else p))
  65.         else ints
  66.     end;
  67.  
  68.     fun toString t = fmt 3 t;
  69.  
  70. fun scan {getc} source =
  71.     let fun skipWSget getc source = getc (StringCvt.skipWS {getc=getc} source)
  72.     fun decval c = Char.ord c - 48;
  73.         fun pow10 0 = 1
  74.       | pow10 n = 10 * pow10 (n-1)
  75.     fun mktime intgv decs fracv =
  76.         let val usecs = (pow10 (7-decs) * fracv + 5) quot 10
  77.         in
  78.         {sec = floor(intgv+real timebase+0.5) + usecs quot 1000000, 
  79.          usec = usecs rem 1000000}
  80.         end
  81.     fun skipdigs src =
  82.         case getc src of 
  83.         NONE          => src
  84.           | SOME(c, rest) => if Char.isDigit c then skipdigs rest 
  85.                  else src
  86.     fun frac intgv decs fracv src =
  87.         if decs >= 7 then SOME(mktime intgv decs fracv, skipdigs src)
  88.         else case getc src of
  89.         NONE          => SOME(mktime intgv decs fracv, src)
  90.           | SOME(c, rest) => 
  91.             if Char.isDigit c then 
  92.             frac intgv (decs+1) (10 * fracv + decval c) rest
  93.             else 
  94.             SOME(mktime intgv decs fracv, src)
  95.     fun intg intgv src = 
  96.         case getc src of
  97.         NONE              => SOME(mktime intgv 6 0, src)
  98.           | SOME (#".", rest) => frac intgv 0 0 rest
  99.           | SOME (c, rest)    => 
  100.             if Char.isDigit c then 
  101.             intg (10.0 * intgv + real(decval c)) rest 
  102.             else SOME(mktime intgv 6 0, src)
  103.     in case skipWSget getc source of
  104.     NONE             => NONE
  105.       | SOME(#".", rest) => 
  106.             (case getc rest of
  107.              NONE          => NONE
  108.                | SOME(c, rest) => 
  109.                  if Char.isDigit c then frac 0.0 1 (decval c) rest
  110.                  else NONE)
  111.       | SOME(c, rest)    => 
  112.         if Char.isDigit c then intg (real (decval c)) rest else NONE
  113.     end;
  114.  
  115.     fun fromString s = StringCvt.scanString scan s;
  116.  
  117.     val op + = fn ({sec=sec1, usec=usec1} : time, {sec=sec2, usec=usec2}) =>
  118.     let val usecs = usec1 + usec2 in
  119.         {sec  = sec1 - timebase + sec2 + usecs div 1000000,
  120.          usec = usecs mod 1000000}
  121.     end handle Overflow => raise Time
  122.     and op - = fn ({sec=sec1, usec=usec1} : time, {sec=sec2, usec=usec2}) =>
  123.     let val usecs = usec1 - usec2 
  124.         val secs  = sec1 - sec2 + usecs div 1000000
  125.     in
  126.         if secs < 0 then raise Time 
  127.         else {sec = secs + timebase, usec = usecs mod 1000000}
  128.     end handle Overflow => raise Time;
  129.  
  130.     val op <  = fn ({sec=sec1, usec=usec1} : time, {sec=sec2, usec=usec2}) =>
  131.     (sec1 < sec2) orelse (sec1=sec2 andalso usec1 < usec2)
  132.     and op <= = fn ({sec=sec1, usec=usec1} : time, {sec=sec2, usec=usec2}) =>
  133.     (sec1 < sec2) orelse (sec1=sec2 andalso usec1 <= usec2)
  134.     and op >  = fn ({sec=sec1, usec=usec1} : time, {sec=sec2, usec=usec2}) =>
  135.     (sec1 > sec2) orelse (sec1=sec2 andalso usec1 > usec2)
  136.     and op >= = fn ({sec=sec1, usec=usec1} : time, {sec=sec2, usec=usec2}) =>
  137.     (sec1 > sec2) orelse (sec1=sec2 andalso usec1 >= usec2);
  138.  
  139.     fun compare (x, y: time) = 
  140.     if x<y then LESS else if x>y then GREATER else EQUAL;
  141.  
  142. end
  143.